home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / REAL Windo272419302001.psc / XPCommandButton.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  2001-09-30  |  8.5 KB  |  303 lines
  1. VERSION 5.00
  2. Begin VB.UserControl XPCommandButton 
  3.    Appearance      =   0  'Flat
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4800
  8.    DefaultCancel   =   -1  'True
  9.    BeginProperty Font 
  10.       Name            =   "Tahoma"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   400
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    ScaleHeight     =   240
  19.    ScaleMode       =   0  'User
  20.    ScaleWidth      =   320
  21.    Begin VB.Timer Timer1 
  22.       Interval        =   1
  23.       Left            =   4800
  24.       Top             =   3480
  25.    End
  26.    Begin VB.CommandButton StandardButton 
  27.       Caption         =   "XPCommandButton"
  28.       BeginProperty Font 
  29.          Name            =   "MS Sans Serif"
  30.          Size            =   8.25
  31.          Charset         =   0
  32.          Weight          =   400
  33.          Underline       =   0   'False
  34.          Italic          =   0   'False
  35.          Strikethrough   =   0   'False
  36.       EndProperty
  37.       Height          =   375
  38.       Left            =   0
  39.       TabIndex        =   0
  40.       Top             =   0
  41.       Visible         =   0   'False
  42.       Width           =   1935
  43.    End
  44. End
  45. Attribute VB_Name = "XPCommandButton"
  46. Attribute VB_GlobalNameSpace = False
  47. Attribute VB_Creatable = True
  48. Attribute VB_PredeclaredId = False
  49. Attribute VB_Exposed = False
  50. ' WINDOWS XP COMMAND BUTTON CONTROL.
  51. ' (c) 2001 dr.-evil@mad.scientist.com.  All rights reserved.
  52. ' You may use this control in your applications free of charge,
  53. ' provided that you do not redistribute this source code without
  54. ' giving me credit for my work.  Of course, credit in your
  55. ' applications is always welcome.
  56.  
  57. Public Event Click()
  58. Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  59. Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  60. Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  61.  
  62. Dim MyState As BtnState
  63. Dim LastState As BtnState
  64. Dim MouseIsDown As Boolean
  65. Dim IsKeyDown As Boolean
  66.  
  67. Dim s_Enabled As Boolean
  68. Dim s_Caption As String
  69. Dim s_Font As Font
  70.  
  71. Public Property Get Caption() As String
  72. Caption = s_Caption
  73. End Property
  74.  
  75. Public Property Get Enabled() As Boolean
  76. Enabled = s_Enabled
  77. End Property
  78.  
  79. Public Property Get Font() As Font
  80. Set Font = s_Font
  81. End Property
  82.  
  83. Public Property Let Caption(Val As String)
  84. s_Caption = Val
  85. StandardButton.Caption = Val
  86. Draw True   ' force a redraw so the that the new caption is shown.
  87. End Property
  88.  
  89. Public Property Let Enabled(Val As Boolean)
  90. s_Enabled = Val
  91. If Not Val Then
  92. MyState = Disabled
  93. UserControl.Enabled = False
  94. ElseIf Val And (UserControl.Ambient.DisplayAsDefault) Then
  95. MyState = Defaulted
  96. UserControl.Enabled = True
  97. Else
  98. MyState = Normal
  99. UserControl.Enabled = True
  100. End If
  101. Draw
  102. StandardButton.Enabled = Val
  103. End Property
  104.  
  105. Public Property Set Font(Val As Font)
  106. Set s_Font = Val
  107. Set UserControl.Font = Val
  108. Set StandardButton.Font = Val
  109. Draw
  110. End Property
  111.  
  112. Private Sub StandardButton_Click()
  113. RaiseEvent Click
  114. End Sub
  115.  
  116. Private Sub StandardButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  117. RaiseEvent MouseDown(Button, Shift, X, Y)
  118. End Sub
  119.  
  120. Private Sub StandardButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  121. RaiseEvent MouseMove(Button, Shift, X, Y)
  122. End Sub
  123.  
  124. Private Sub StandardButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  125. RaiseEvent MouseUp(Button, Shift, X, Y)
  126. End Sub
  127.  
  128. Private Sub Timer1_Timer()    ' this provides for a MouseOut event.
  129. If Not MouseIsDown Then
  130.     Dim Mouse As POINT_API
  131.     GetCursorPos Mouse
  132.     ScreenToClient hWnd, Mouse
  133.     If (Mouse.X < UserControl.ScaleLeft) Or (Mouse.Y < UserControl.ScaleTop) Or (Mouse.X > (UserControl.ScaleLeft + UserControl.ScaleWidth)) Or Mouse.Y > ((UserControl.ScaleTop + UserControl.ScaleHeight)) Then
  134.         Timer1.Enabled = False
  135.         If UserControl.Ambient.DisplayAsDefault Then
  136.         MyState = Defaulted
  137.         Else
  138.         MyState = Normal
  139.         End If
  140.         Draw
  141.     End If
  142. End If
  143. End Sub
  144.  
  145. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  146. If KeyAscii = 13 Then
  147.     If s_Enabled Then
  148.     RaiseEvent Click
  149.     Else
  150.     Beep
  151.     End If
  152. End If
  153. End Sub
  154.  
  155. Private Sub UserControl_AmbientChanged(PropertyName As String)
  156. If Not ThemesSupported Then                                         ' this event usually happens when another control on the form gets focus.
  157. StandardButton.Default = UserControl.Ambient.DisplayAsDefault
  158. ElseIf PropertyName = "DisplayAsDefault" Then
  159. If (MyState = Normal) And UserControl.Ambient.DisplayAsDefault Then
  160. MyState = Defaulted
  161. ElseIf (MyState = Defaulted) And Not UserControl.Ambient.DisplayAsDefault Then
  162. MyState = Normal
  163. End If
  164. Draw
  165. End If
  166. End Sub
  167.  
  168. Private Sub UserControl_GotFocus()
  169. If Not s_Enabled Then Beep
  170. End Sub
  171.  
  172. Private Sub UserControl_Initialize()    ' check if the system supports themes.
  173. If ThemesSupported Then                 ' if so, then get ready to use them.
  174. StandardButton.Visible = False          ' if not, then show the standard command button.
  175. MyState = Normal
  176. Else
  177. With StandardButton
  178. .Visible = True
  179. .Width = Width
  180. .Height = Height
  181. End With
  182. End If
  183. End Sub
  184.  
  185. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  186. If (KeyCode = 32) And s_Enabled Then
  187. IsKeyDown = True
  188. MyState = Pressed
  189. Draw
  190. End If
  191. End Sub
  192.  
  193. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  194. If (KeyCode = 32) And s_Enabled Then
  195. IsKeyDown = False
  196. MyState = Defaulted
  197. RaiseEvent Click
  198. Draw
  199. End If
  200. End Sub
  201.  
  202. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  203. If Not IsKeyDown Then
  204. If (MyState <> Disabled) And (Button = 1) Then
  205. MyState = Pressed
  206. Draw
  207. End If
  208. MouseIsDown = True
  209. If s_Enabled Then RaiseEvent MouseDown(Button, Shift, X, Y)
  210. End If
  211. End Sub
  212.  
  213. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  214. If Not IsKeyDown Then
  215. If Button = 1 And Not MouseIsDown Then
  216. MyState = MouseOver
  217. Draw
  218. End If
  219. If (MyState <> Disabled) And (MyState <> Pressed) And (Button = 0) Then
  220. MyState = MouseOver
  221. Draw
  222. ElseIf (MyState <> Disabled) And ((X > UserControl.ScaleWidth) Or (Y > UserControl.ScaleHeight) Or (X < 0) Or (Y < 0)) Then
  223. MyState = MouseOver
  224. Draw
  225. ElseIf (MyState <> Disabled) And (Button = 1) Then
  226. MyState = Pressed
  227. Draw
  228. End If
  229. RaiseEvent MouseMove(Button, Shift, X, Y)
  230. If s_Enabled And ThemesSupported Then Timer1.Enabled = True
  231. End If
  232. End Sub
  233.  
  234. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  235. If Not IsKeyDown Then
  236. If MyState = MouseOver Then
  237. MyState = Defaulted
  238. Draw
  239. ElseIf MyState = Pressed Then
  240. MyState = MouseOver
  241. Draw
  242. End If
  243. If (X >= 0) And (Y >= 0) And (X <= UserControl.ScaleWidth) And (Y <= UserControl.ScaleHeight) And (Button = 1) Then RaiseEvent Click
  244. MouseIsDown = False
  245. If s_Enabled Then RaiseEvent MouseUp(Button, Shift, X, Y)
  246. End If
  247. End Sub
  248.  
  249. Private Sub UserControl_Paint()
  250. Draw True
  251. End Sub
  252.  
  253. Private Sub UserControl_Resize()
  254. If ThemesSupported Then
  255. UserControl.ScaleMode = 3
  256. Draw
  257. Else
  258. UserControl.ScaleMode = 1
  259. With StandardButton
  260. .Width = UserControl.Width
  261. .Height = UserControl.Height
  262. End With
  263. End If
  264. End Sub
  265.  
  266. Private Sub Draw(Optional Force As Boolean)
  267. If ThemesSupported Then
  268. Dim MyRECT As RECT
  269. MyRECT.Top = 0
  270. MyRECT.Left = 0
  271. MyRECT.Right = UserControl.ScaleWidth
  272. MyRECT.bottom = UserControl.ScaleHeight
  273. If MyState = Normal And UserControl.Ambient.DisplayAsDefault Then MyState = Defaulted
  274. If (MyState <> LastState) Or Force Then  ' if we check this first, it can prevent ALOT of flickering.
  275. DrawButton UserControl.hWnd, UserControl.hDC, MyRECT, s_Caption, MyState
  276. LastState = MyState
  277. End If
  278. Else
  279. StandardButton.Visible = True
  280. End If
  281. End Sub
  282.  
  283.  
  284.  
  285.  
  286. Private Sub UserControl_InitProperties()
  287. s_Caption = "XPCommandButton"
  288. s_Enabled = True
  289. End Sub
  290.  
  291. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  292. Me.Caption = PropBag.ReadProperty("Caption", "XPCommandButton")
  293. Me.Enabled = PropBag.ReadProperty("Enabled", True)
  294. Set Me.Font = PropBag.ReadProperty("Font", UserControl.Ambient.Font)
  295. End Sub
  296.  
  297. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  298. PropBag.WriteProperty "Caption", s_Caption, "XPCommandButton"
  299. PropBag.WriteProperty "Enabled", s_Enabled, True
  300. PropBag.WriteProperty "Font", s_Font, UserControl.Ambient.Font
  301. End Sub
  302.  
  303.